home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / tests / filescan.test < prev    next >
Encoding:
Text File  |  1992-11-07  |  6.5 KB  |  234 lines
  1. #
  2. # filescan.test
  3. #
  4. # Tests for the scancontext and scanfile commands.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: filescan.test,v 2.0 1992/10/16 04:49:47 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. # Increment a name.  This takes a name and "adds one" to it, that is advancing
  22. # each digit lexically through "0"..."9" -> "A"-"Z" -> "a"..."z".  When one
  23. # digit wraps, the next one is advanced.  Optional arg forces upper case only
  24. # if true and start with all upper case or digits.
  25.  
  26. proc IncrName {Name args} {
  27.     set Upper [expr {([llength $args] == 1) && [lindex $args 0]}]
  28.     set Last  [expr [clength $Name]-1]
  29.     set Begin [csubstr $Name 0 $Last]
  30.     set Digit [cindex $Name $Last]
  31.     set Recurse 0
  32.     case $Digit in {
  33.         {9}     {set Digit A}
  34.         {Z}     {if {$Upper} {set Recurse 1} else {set Digit a}}
  35.         {z}     {set Recurse 1}
  36.         default {set Digit [ctype char [expr [ctype ord $Digit]+1]]}
  37.     }
  38.     if {$Recurse} {
  39.         if {$Last == 0} then {
  40.             return 0 ;# Wrap around
  41.         } else {
  42.             return "[IncrName $Begin]0"
  43.         }
  44.     }
  45.     return "$Begin$Digit"
  46. }
  47.  
  48. # Proc to generate record that can be validated.  The record has 
  49. # grows quite large to test the dynamic buffering in the file I/O.
  50.  
  51. proc GenScanRec {Key LineNum} {
  52.   set extra [replicate :@@@@@@@@: $LineNum]
  53.   return  "$Key This is a test record ($extra) index is $Key"
  54. }
  55.  
  56. # Proc to validate a matched record.
  57.  
  58. proc ValMatch {scanInfo errId} {
  59.     global testFH matchInfo
  60.  
  61.     test filescan-${errId}.1 {filescan tests} {
  62.          set matchInfo(line)
  63.     } [GenScanRec [lindex $scanInfo 0] [lindex $scanInfo 2]]
  64.     test filescan-${errId}.2 {filescan tests} {
  65.          set matchInfo(offset)
  66.     } [lindex $scanInfo 1]
  67.     test filescan-${errId}.3 {filescan tests} {
  68.          set matchInfo(linenum)
  69.     } [lindex $scanInfo 2]
  70.     test filescan-${errId}.4 {filescan tests} {
  71.          set matchInfo(handle)
  72.     } $testFH
  73.     set matchType [lindex $scanInfo 3] 
  74.     global matchCnt.$matchType
  75.     incr matchCnt.$matchType
  76. }
  77.  
  78. global matchInfo
  79. global matchCnt.0    matchCnt.1    matchCnt.2    matchCnt.3    DefaultCnt 
  80. global chkMatchCnt.0 chkMatchCnt.1 chkMatchCnt.2 chkMatchCnt.3 chkDefaultCnt
  81. global testFH
  82.  
  83. set matchCnt.0      0
  84. set matchCnt.1      0
  85. set matchCnt.2      0
  86. set matchCnt.3      0
  87. set defaultCnt      0
  88. set chkMatchCnt.0   0
  89. set chkMatchCnt.1   0
  90. set chkMatchCnt.2   0
  91. set chkMatchCnt.3   0
  92. set chkDefaultCnt   0
  93. set scanList       {}
  94. set maxRec        200
  95.  
  96. catch {unlink TEST.TMP}
  97. set testFH [open TEST.TMP w]
  98.  
  99. # Build a test file and a list of records to scan for.  Each element in the 
  100. # list will have the following info:
  101. #   {key fileOffset fileLineNumber matchType}
  102.  
  103. set key FatHeadAAAA
  104. for {set cnt 0} {$cnt < $maxRec} {incr cnt} {
  105.     if {($cnt % 10) == 0} {
  106.         set matchType [random 4]
  107.         incr chkMatchCnt.$matchType
  108.         set scanInfo [list "$key [tell $testFH] [expr $cnt+1] $matchType"]
  109.         if {[random 2]} {
  110.             set scanList [concat $scanList $scanInfo]
  111.         } else {
  112.             set scanList [concat $scanInfo $scanList]}
  113.     } else {
  114.         incr chkDefaultCnt}
  115.     if {$cnt == [expr $maxRec/2]} {
  116.         set midKey $key
  117.         }
  118.     puts $testFH [GenScanRec $key [expr $cnt+1]]
  119.     set key [IncrName $key 1]  ;# Upper case only
  120. }
  121.  
  122. close $testFH
  123.  
  124. # Build up the scan context.
  125.  
  126. set testCH [scancontext create]
  127.  
  128. foreach scanInfo $scanList {
  129.     set key [lindex $scanInfo 0]
  130.     set matchType [lindex $scanInfo 3]
  131.     set cmd "global matchInfo; ValMatch \{$scanInfo\} 1.1" 
  132.     case $matchType in {
  133.       {0} {scanmatch -nocase $testCH [string toupper $key] $cmd}
  134.       {1} {scanmatch $testCH ^$key  $cmd}
  135.       {2} {scanmatch $testCH $key\$ $cmd}
  136.       {3} {scanmatch $testCH $key   $cmd}
  137.     }
  138. }
  139.  
  140. scanmatch $testCH {
  141.     global defaultCnt testFH matchInfo
  142.  
  143.     incr defaultCnt
  144.  
  145.     test filescan-1.2 {filescan tests} {
  146.         set matchInfo(handle)
  147.     } $testFH
  148. }
  149.  
  150. set testFH [open TEST.TMP r]
  151. scanfile $testCH $testFH
  152.  
  153. test filescan-1.3 {filescan tests} {
  154.     set {matchCnt.0}
  155. } ${chkMatchCnt.0}
  156. test filescan-1.4 {filescan tests} {
  157.     set {matchCnt.1}
  158. } ${chkMatchCnt.1}
  159. test filescan-1.5 {filescan tests} {
  160.     set {matchCnt.2}
  161. } ${chkMatchCnt.2}
  162. test filescan-1.6 {filescan tests} {
  163.    set {matchCnt.3}
  164. } ${chkMatchCnt.3}
  165. test filescan-1.7 {filescan tests} {
  166.     set defaultCnt
  167. } $chkDefaultCnt
  168.  
  169. scancontext delete $testCH
  170.  
  171. # Test return and continue from within match commands
  172.  
  173. set testCH [scancontext create]
  174. seek $testFH 0
  175. global matchCnt
  176. set matchCnt 0
  177.  
  178. scanmatch $testCH $midKey {
  179.     global matchCnt
  180.     incr matchCnt
  181.     continue;
  182. }
  183.  
  184. scanmatch $testCH ^$midKey {
  185.     error "This should not ever get executed  2.1"
  186. }
  187.  
  188. scanmatch $testCH [IncrName $midKey] {
  189.     return "FudPucker"
  190. }
  191.  
  192. test filescan-2.2 {filescan tests} {
  193.     scanfile $testCH $testFH
  194. } "FudPucker"
  195.  
  196. scancontext delete $testCH
  197.  
  198.  
  199. # Test argument checking and error handling.
  200.  
  201. test filescan-3.1 {filescan tests} {
  202.     list [catch {scancontext foomuch} msg] $msg
  203. } {1 {invalid argument, expected one of: create or delete}}
  204.  
  205. test filescan-3.2 {filescan tests} {
  206.     list [catch {scanmatch $testCH} msg] $msg
  207. } {1 {wrong # args: scanmatch [-nocase] contexthandle [regexp] command}}
  208.  
  209. test filescan-3.3 {filescan tests} {
  210.     list [catch {scanmatch} msg] $msg
  211. } {1 {wrong # args: scanmatch [-nocase] contexthandle [regexp] command}}
  212.  
  213. test filescan-3.4 {filescan tests} {
  214.     list [catch {scanfile} msg] $msg
  215. } {1 {wrong # args: scanfile contexthandle filehandle}}
  216.  
  217. test filescan-3.5 {filescan tests} {
  218.     set testCH [scancontext create]
  219.     set msg [list [catch {scanfile $testCH $testFH} msg] $msg]
  220.     scancontext delete $testCH
  221.     set msg
  222. } {1 {no patterns in current scan context}}
  223.  
  224. close $testFH
  225. unlink TEST.TMP
  226.  
  227. rename GenScanRec {}
  228. rename ValMatch {}
  229.  
  230. unset matchCnt matchInfo
  231. unset matchCnt.0    matchCnt.1    matchCnt.2    matchCnt.3    defaultCnt 
  232. unset chkMatchCnt.0 chkMatchCnt.1 chkMatchCnt.2 chkMatchCnt.3 chkDefaultCnt
  233. unset testFH
  234.